home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / T-TPUG Old Monthly Disks / (c)tv.d64 / hrtest.c (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  2KB  |  85 lines
  1. 10 IF A=0 THEN A=1:LOAD"HRSUPP.D",8,1
  2. 20 BA=6*16^3:REM BASE ADDRESS
  3. 30 IN=BA:REM INITIALIZE
  4. 40 RS=BA+3:REM RESTORE
  5. 50 CL=BA+6:REM CLEAR
  6. 60 DR=BA+9:REM DRAW
  7. 70 PX=BA+12:REM SET PIXEL ON
  8. 80 MV=BA+15:REM MOVE
  9. 90 SYS(IN)
  10. 95 :
  11. 100 S=3:SYS(MV),S,S:FOR I=S TO 195 STEP S
  12. 110 X1=S:Y1=X1:X2=X1:Y2=Y1+I
  13. 120 X3=X2+I:Y3=Y2:X4=X3:Y4=Y3-I
  14. 130 SYSDR,X2,198
  15. 140 SYSDR,X3,Y3
  16. 150 SYSDR,X4,Y4
  17. 160 SYSDR,X1,Y1
  18. 170 NEXT I
  19. 180 GET A$:IF A$<>"C" THEN 180
  20. 190 :
  21. 200 R=80:XC=160:YC=100:A=(null)/180:S=5
  22. 210 SYS(CL)
  23. 220 FOR AN = 0 TO (null)/1.99 STEP (null)/20
  24. 230 SYSMV,XC+R*SIN(AN),YC+R*SIN(AN)
  25. 240 FOR I=S TO 360 STEP S
  26. 250 SYSDR,XC+R*SIN(2*I*A+AN),YC+R*SIN(I*A+AN)
  27. 260 NEXT I,AN
  28. 270 GET A$:IF A$<>"C" THEN 270
  29. 280 :
  30. 300 SYS(CL)
  31. 310 D=4:E=2:X=XC:Y=YC
  32. 320 SYSMV,X,Y
  33. 330 FOR I=0 TO 20
  34. 340 D=D+E:Y=Y+D:SYSDR,X,Y
  35. 350 D=D+E:X=X+D:SYSDR,X,Y
  36. 360 D=D+E:Y=Y-D:SYSDR,X,Y
  37. 370 D=D+E:X=X-D:SYSDR,X,Y
  38. 380 NEXT I
  39. 390 GET A$:IF A$<>"C" THEN 390
  40. 395 :
  41. 400 SYSCL:S=(null)/3
  42. 410 FOR T=0 TO S STEP S/8
  43. 420 SYSMV,XC+R*COS(T),YC+R*SIN(T)
  44. 430 FOR I=S TO 2*(null) STEP S
  45. 440 SYSDR,XC+R*COS(I+T),YC+R*SIN(I+T)
  46. 450 NEXT I,T
  47. 460 GET A$:IF A$<>"C" THEN 460
  48. 470 :
  49. 500 SYSCL:S=(null)/4:D=R/20
  50. 510 FOR T=0 TO S STEP S/20
  51. 520 SYSMV,XC+R*COS(T),YC+R*SIN(T)
  52. 530 FOR I=S TO 2*(null) STEP S
  53. 540 SYSDR,XC+R*COS(I+T),YC+R*SIN(I+T)
  54. 550 NEXT I
  55. 560 R=R-D:NEXT T
  56. 580 GET A$:IF A$<>"C" THEN 580
  57. 590 :
  58. 600 SYSCL:R=80:S=(null)/8:D=R/20
  59. 610 FOR T=0 TO S STEP S/40
  60. 620 SYSPX,XC+R*COS(T),YC+R*SIN(T)
  61. 630 FOR I=S TO 2*(null) STEP S
  62. 640 SYSPX,XC+R*COS(I+T),YC+R*SIN(I+T)
  63. 650 NEXT I
  64. 660 R=R-D:NEXT T
  65. 680 GET A$:IF A$<>"C" THEN 680
  66. 690 :
  67. 700 SYSCL:R=80:S=2*(null)/5:A=(null)/10
  68. 710 FOR I=0 TO 4
  69. 720 T=A+I*S
  70. 730 X(I)=XC+R*COS(T):Y(I)=YC+R*SIN(T)
  71. 740 NEXT I
  72. 750 SYSMV,X(0),Y(0)
  73. 760 SYSDR,X(2),Y(2):SYSDR,X(4),Y(4)
  74. 770 SYSDR,X(1),Y(1):SYSDR,X(3),Y(3)
  75. 780 SYSDR,X(0),Y(0)
  76. 790 GET A$:IF A$<>"C" THEN 760
  77. 795 :
  78. 800 SYSCL:A=160:B=A/2:SYSMV,0,A*EXP(-4)
  79. 810 FOR X=4 TO 2*A-1 STEP 4
  80. 820 SYSDR,X,A*EXP(-((X-A)/B)^2)
  81. 830 NEXT X
  82. 880 GET A$:IF A$<>"C" THEN 880
  83. 890 :
  84. 9999 SYS(RS)
  85.